In this report, we reproduce the analyses using data from follow-up behavioral study 2 reported in Supplementary Material.
First, we load the relevant packages, define functions and plotting aesthetics, and load and tidy the data.
if(!require('pacman')) {
install.packages('pacman')
}
pacman::p_load(tidyverse, purrr, fs, knitr, lmerTest, ggeffects, kableExtra, boot, devtools, EMAtools, install = TRUE)
devtools::install_github("hadley/emo")# MLM results table function
table_model = function(model_data) {
model_data %>%
broom.mixed::tidy(conf.int = TRUE) %>%
filter(effect == "fixed") %>%
rename("SE" = std.error,
"t" = statistic,
"p" = p.value) %>%
select(-group, -effect) %>%
mutate_at(vars(-contains("term"), -contains("p")), round, 2) %>%
mutate(term = gsub("cond", "", term),
term = gsub("\\(Intercept\\)", "intercept", term),
term = gsub("article_other", "other", term),
term = gsub("article_self", "self", term),
term = gsub("topichealth", "topic (health)", term),
term = gsub("msg_rel_self", "self-relevance", term),
term = gsub("msg_rel_social", "social relevance", term),
term = gsub(":", " x ", term),
p = ifelse(p < .001, "< .001",
ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
`b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(term, `b [95% CI]`, df, t, p)
}
# simple effects function
simple_effects = function(model, sharing = FALSE) {
if(sharing == FALSE) {
results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group),
"revpairwise", by = "group", adjust = "none") %>%
data.frame() %>%
filter(grepl("control", contrast)) %>%
select(contrast, group, estimate, p.value)
} else {
results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group + sharing_type),
"revpairwise", by = "group", adjust = "none") %>%
data.frame() %>%
filter(grepl("- control", contrast)) %>%
filter(!grepl("^control", contrast)) %>%
extract(contrast, c("exp_sharing", "control_sharing"), ".* (0|1) - control (0|1)", remove = FALSE) %>%
filter(exp_sharing == control_sharing) %>%
mutate(sharing_type = ifelse(exp_sharing == 0, "broadcast", "narrowcast"),
contrast = gsub("0|1", "", contrast)) %>%
select(contrast, sharing_type, group, estimate, p.value)
}
results %>%
mutate(p.value = ifelse(p.value < .001, "< .001",
ifelse(p.value == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p.value))))) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()
}palette_condition = c("#ee9b00", "#bb3e03", "#005f73")
palette_topic = c("climate" = "#E6805E",
"health" = "#3A3357")
plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 12),
text = element_text(size = 16, family = "Futura Medium"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())data = read.csv("../data/study2_data.csv", stringsAsFactors = FALSE) %>%
mutate(article_cond = ifelse(article_cond == "social", "other", article_cond))
n_words = read.csv("../data/study2_n_words.csv", stringsAsFactors = FALSE) %>%
mutate(article_cond = ifelse(article_cond == "social", "other", article_cond))These analyses explore whether the analyses reported in follow-up behavioral study 2 of the main manuscript are moderated by article topic (health or climate). We focus on the comment group only because this is the only group for which the intervention was effective.
data_comment = data %>%
filter(group == "comment") %>%
select(-group)Are the effects of the experimental manipulations on relevance moderated by article topic?
There is a main effect of topic such that health articles are rated as more self-relevant than climate articles.
The was also an interaction such that the effect of the self-focused condition on self-relevance was weaker for health articles.
mod_h2a = lmer(msg_rel_self ~ article_cond * topic + (1 | SID),
data = filter(data_comment, sharing_type == 0),
control = lmerControl(optimizer = "bobyqa"))table_h2a = table_model(mod_h2a)
table_h2a %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 50.28 [45.29, 55.27] | 303.98 | 19.83 | < .001 |
| other | 7.15 [2.37, 11.92] | 1383.38 | 2.93 | .003 |
| self | 13.65 [8.93, 18.37] | 1375.83 | 5.67 | < .001 |
| topic (health) | -1.50 [-6.32, 3.33] | 1381.50 | -0.61 | .543 |
| other x topic (health) | -5.77 [-12.66, 1.13] | 1393.15 | -1.64 | .101 |
| self x topic (health) | 2.00 [-4.90, 8.89] | 1390.12 | 0.57 | .570 |
summary(mod_h2a)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self ~ article_cond * topic + (1 | SID)
## Data: filter(data_comment, sharing_type == 0)
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 14244.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.11437 -0.62440 0.09301 0.68148 2.67978
##
## Random effects:
## Groups Name Variance Std.Dev.
## SID (Intercept) 453.9 21.30
## Residual 699.9 26.46
## Number of obs: 1491, groups: SID, 127
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 50.283 2.535 303.976 19.833
## article_condother 7.146 2.435 1383.378 2.935
## article_condself 13.650 2.406 1375.831 5.674
## topichealth -1.495 2.459 1381.502 -0.608
## article_condother:topichealth -5.766 3.513 1393.147 -1.641
## article_condself:topichealth 1.998 3.516 1390.121 0.568
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## article_condother 0.00339 **
## article_condself 0.000000017 ***
## topichealth 0.54328
## article_condother:topichealth 0.10096
## article_condself:topichealth 0.57002
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) artcl_cndt artcl_cnds tpchlt artcl_cndt:
## artcl_cndth -0.469
## artcl_cndsl -0.468 0.488
## topichealth -0.465 0.500 0.504
## artcl_cndt: 0.338 -0.722 -0.354 -0.721
## artcl_cnds: 0.334 -0.348 -0.714 -0.719 0.504
predicted_h2 = ggeffects::ggpredict(mod_h2a, c("article_cond", "topic")) %>%
data.frame() %>%
mutate(model = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h2b, c("article_cond", "topic")) %>%
data.frame() %>%
mutate(model = "social relevance")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
ind_data_h2 = data_comment %>%
rename("x" = article_cond,
"group" = topic) %>%
gather(model, predicted, msg_rel_self, msg_rel_social) %>%
mutate(x = factor(x, levels = c("self", "control", "other")),
model = gsub("msg_rel_self", "self-relevance", model),
model = gsub("msg_rel_social", "social relevance", model))
(plot_h2 = predicted_h2 %>%
ggplot(aes(x = x, y = predicted, color = group)) +
stat_summary(data = ind_data_h2, aes(group = interaction(SID, group)), fun = "mean", geom = "line", size = .1, alpha = .75) +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
size = .75, position = position_dodge(.1)) +
facet_grid(~model) +
scale_color_manual(name = "", values = palette_topic) +
labs(x = "", y = "predicted rating\n") +
plot_aes +
theme(legend.position = c(.9, .2)))Are the relationships between self and social relevance and sharing intentions moderated by article topic?
The relationship between self-relevance and sharing intentions was not moderated by topic.
However, the relationship between social relevance and sharing intentions was slightly stronger for health articles compared to climate articles.
mod_h3 = lmer(msg_share ~ msg_rel_self * topic + msg_rel_social * topic + (1 + msg_rel_self | SID),
data = data_comment,
control = lmerControl(optimizer = "bobyqa"))predicted = ggeffects::ggpredict(mod_h3, c("msg_rel_self", "topic")) %>%
data.frame() %>%
mutate(variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h3, c("msg_rel_social", "topic")) %>%
data.frame() %>%
mutate(variable = "social relevance"))
points = data_comment %>%
rename("predicted" = msg_share,
"group" = topic) %>%
gather(variable, x, msg_rel_self, msg_rel_social) %>%
mutate(variable = gsub("msg_rel_self", "self-relevance", variable),
variable = gsub("msg_rel_social", "social relevance", variable))
(plot_rel_sharing = predicted %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
stat_smooth(data = points, aes(group = interaction(SID, group)), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
facet_grid(~variable) +
scale_color_manual(name = "", values = palette_topic) +
scale_fill_manual(name = "", values = palette_topic) +
labs(x = "\nrating", y = "predicted sharing intention\n") +
plot_aes)table_h3 = table_model(mod_h3)
table_h3 %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 4.30 [0.95, 7.64] | 172.83 | 2.54 | .012 |
| self-relevance | 0.12 [0.05, 0.20] | 533.58 | 3.23 | .001 |
| topic (health) | -1.02 [-4.39, 2.34] | 2623.23 | -0.60 | .551 |
| social relevance | 0.35 [0.29, 0.42] | 2160.26 | 10.40 | < .001 |
| self-relevance x topic (health) | -0.01 [-0.09, 0.06] | 2551.45 | -0.37 | .714 |
| topic (health) x social relevance | 0.04 [-0.04, 0.12] | 2406.08 | 0.93 | .350 |
summary(mod_h3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ msg_rel_self * topic + msg_rel_social * topic + (1 +
## msg_rel_self | SID)
## Data: data_comment
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 26935.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5637 -0.5159 -0.0467 0.3751 3.7795
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## SID (Intercept) 131.15619 11.45
## msg_rel_self 0.04002 0.20 0.27
## Residual 422.70870 20.56
## Number of obs: 2982, groups: SID, 127
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 4.29877 1.69468 172.82574 2.537
## msg_rel_self 0.12174 0.03765 533.57860 3.234
## topichealth -1.02410 1.71627 2623.23157 -0.597
## msg_rel_social 0.35446 0.03410 2160.26304 10.395
## msg_rel_self:topichealth -0.01438 0.03917 2551.44626 -0.367
## topichealth:msg_rel_social 0.03828 0.04094 2406.07685 0.935
## Pr(>|t|)
## (Intercept) 0.0121 *
## msg_rel_self 0.0013 **
## topichealth 0.5508
## msg_rel_social <0.0000000000000002 ***
## msg_rel_self:topichealth 0.7136
## topichealth:msg_rel_social 0.3499
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) msg_rl_sl tpchlt msg_rl_sc msg__:
## msg_rel_slf -0.053
## topichealth -0.471 0.093
## msg_rel_scl -0.308 -0.701 0.205
## msg_rl_slf: 0.079 -0.700 -0.116 0.672
## tpchlth:m__ 0.187 0.577 -0.434 -0.763 -0.802
## optimizer (bobyqa) convergence code: 0 (OK)
## Model is nearly unidentifiable: very large eigenvalue
## - Rescale variables?
Are the effects of the experimental manipulations on sharing intentions moderated by article topic?
There is a main effect of topic, such that health articles have higher sharing intentions than climate articles.
These data are not consistent with moderation by topic.
mod_h5 = lmer(msg_share ~ article_cond * topic + (1 | SID),
data = data_comment,
control = lmerControl(optimizer = "bobyqa"))predicted_h5 = ggeffects::ggpredict(mod_h5, c("article_cond", "topic")) %>%
data.frame() %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
ind_data_h5 = data_comment %>%
rename("x" = article_cond,
"predicted" = msg_share,
"group" = topic) %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_h5 %>%
ggplot(aes(x = x, y = predicted, color = group)) +
stat_summary(data = ind_data_h5, aes(group = interaction(SID, group)), fun = "mean", geom = "line", size = .1, alpha = .75) +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
size = .75, position = position_dodge(.1)) +
scale_color_manual(name = "", values = palette_topic) +
labs(x = "", y = "predicted sharing intention\n") +
plot_aes +
theme(legend.position = c(.9, .2))table_h5 = table_model(mod_h5)
table_h5 %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 28.06 [23.20, 32.92] | 174.34 | 11.40 | < .001 |
| other | 9.60 [6.64, 12.56] | 2867.34 | 6.35 | < .001 |
| self | 8.08 [5.15, 11.00] | 2860.36 | 5.42 | < .001 |
| topic (health) | 1.04 [-1.95, 4.03] | 2864.03 | 0.68 | .497 |
| other x topic (health) | 1.86 [-2.42, 6.14] | 2872.33 | 0.85 | .394 |
| self x topic (health) | -1.24 [-5.52, 3.05] | 2869.63 | -0.57 | .572 |
summary(mod_h5)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ article_cond * topic + (1 | SID)
## Data: data_comment
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 27601.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3081 -0.5742 -0.1144 0.4179 3.3886
##
## Random effects:
## Groups Name Variance Std.Dev.
## SID (Intercept) 629.3 25.08
## Residual 535.6 23.14
## Number of obs: 2982, groups: SID, 127
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 28.059 2.461 174.342 11.402
## article_condother 9.601 1.511 2867.340 6.354
## article_condself 8.078 1.491 2860.361 5.418
## topichealth 1.037 1.526 2864.032 0.680
## article_condother:topichealth 1.863 2.183 2872.332 0.853
## article_condself:topichealth -1.236 2.184 2869.633 -0.566
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## article_condother 0.000000000244 ***
## article_condself 0.000000065361 ***
## topichealth 0.497
## article_condother:topichealth 0.394
## article_condself:topichealth 0.572
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) artcl_cndt artcl_cnds tpchlt artcl_cndt:
## artcl_cndth -0.300
## artcl_cndsl -0.299 0.488
## topichealth -0.297 0.501 0.506
## artcl_cndt: 0.217 -0.724 -0.355 -0.721
## artcl_cnds: 0.214 -0.348 -0.715 -0.720 0.504
table_h2a %>% mutate(DV = "H2a: Self-relevance") %>%
bind_rows(table_h2b %>% mutate(DV = "H2b: Social relevance")) %>%
bind_rows(table_h3 %>% mutate(DV = "H3a-b: Sharing intention")) %>%
bind_rows(table_h5 %>% mutate(DV = "H5: Sharing intention")) %>%
select(DV, everything()) %>%
kable() %>%
kable_styling()| DV | term | b [95% CI] | df | t | p |
|---|---|---|---|---|---|
| H2a: Self-relevance | intercept | 50.28 [45.29, 55.27] | 303.98 | 19.83 | < .001 |
| H2a: Self-relevance | other | 7.15 [2.37, 11.92] | 1383.38 | 2.93 | .003 |
| H2a: Self-relevance | self | 13.65 [8.93, 18.37] | 1375.83 | 5.67 | < .001 |
| H2a: Self-relevance | topic (health) | -1.50 [-6.32, 3.33] | 1381.50 | -0.61 | .543 |
| H2a: Self-relevance | other x topic (health) | -5.77 [-12.66, 1.13] | 1393.15 | -1.64 | .101 |
| H2a: Self-relevance | self x topic (health) | 2.00 [-4.90, 8.89] | 1390.12 | 0.57 | .570 |
| H2b: Social relevance | intercept | 49.99 [45.14, 54.84] | 254.66 | 20.30 | < .001 |
| H2b: Social relevance | other | 16.67 [12.45, 20.88] | 1378.20 | 7.76 | < .001 |
| H2b: Social relevance | self | 13.37 [9.20, 17.53] | 1371.74 | 6.30 | < .001 |
| H2b: Social relevance | topic (health) | 6.93 [2.67, 11.19] | 1376.05 | 3.19 | .001 |
| H2b: Social relevance | other x topic (health) | -3.93 [-10.01, 2.16] | 1385.24 | -1.27 | .206 |
| H2b: Social relevance | self x topic (health) | -6.04 [-12.13, 0.05] | 1382.65 | -1.95 | .052 |
| H3a-b: Sharing intention | intercept | 4.30 [0.95, 7.64] | 172.83 | 2.54 | .012 |
| H3a-b: Sharing intention | self-relevance | 0.12 [0.05, 0.20] | 533.58 | 3.23 | .001 |
| H3a-b: Sharing intention | topic (health) | -1.02 [-4.39, 2.34] | 2623.23 | -0.60 | .551 |
| H3a-b: Sharing intention | social relevance | 0.35 [0.29, 0.42] | 2160.26 | 10.40 | < .001 |
| H3a-b: Sharing intention | self-relevance x topic (health) | -0.01 [-0.09, 0.06] | 2551.45 | -0.37 | .714 |
| H3a-b: Sharing intention | topic (health) x social relevance | 0.04 [-0.04, 0.12] | 2406.08 | 0.93 | .350 |
| H5: Sharing intention | intercept | 28.06 [23.20, 32.92] | 174.34 | 11.40 | < .001 |
| H5: Sharing intention | other | 9.60 [6.64, 12.56] | 2867.34 | 6.35 | < .001 |
| H5: Sharing intention | self | 8.08 [5.15, 11.00] | 2860.36 | 5.42 | < .001 |
| H5: Sharing intention | topic (health) | 1.04 [-1.95, 4.03] | 2864.03 | 0.68 | .497 |
| H5: Sharing intention | other x topic (health) | 1.86 [-2.42, 6.14] | 2872.33 | 0.85 | .394 |
| H5: Sharing intention | self x topic (health) | -1.24 [-5.52, 3.05] | 2869.63 | -0.57 | .572 |
report::cite_packages()## - Angelo Canty and Brian Ripley (2021). boot: Bootstrap R (S-Plus) Functions. R package version 1.3-28.
## - Douglas Bates, Martin Maechler and Mikael Jagan (2023). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.5-4. https://CRAN.R-project.org/package=Matrix
## - Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
## - Evan Kleiman (2021). EMAtools: Data Management Tools for Real-Time Monitoring/Ecological Momentary Assessment Data. R package version 0.1.4. https://CRAN.R-project.org/package=EMAtools
## - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
## - Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr
## - Hadley Wickham (2021). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.1. https://CRAN.R-project.org/package=forcats
## - Hadley Wickham and Maximilian Girlich (2022). tidyr: Tidy Messy Data. R package version 1.2.0. https://CRAN.R-project.org/package=tidyr
## - Hadley Wickham, Jennifer Bryan and Malcolm Barrett (2021). usethis: Automate Package and Project Setup. R package version 2.1.5. https://CRAN.R-project.org/package=usethis
## - Hadley Wickham, Jim Hester and Jennifer Bryan (2022). readr: Read Rectangular Text Data. R package version 2.1.2. https://CRAN.R-project.org/package=readr
## - Hadley Wickham, Jim Hester, Winston Chang and Jennifer Bryan (2021). devtools: Tools to Make Developing R Packages Easier. R package version 2.4.3. https://CRAN.R-project.org/package=devtools
## - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2022). dplyr: A Grammar of Data Manipulation. R package version 1.0.9. https://CRAN.R-project.org/package=dplyr
## - Hao Zhu (2021). kableExtra: Construct Complex Table with 'kable' and Pipe Syntax. R package version 1.3.4. https://CRAN.R-project.org/package=kableExtra
## - Jim Hester, Hadley Wickham and Gábor Csárdi (2021). fs: Cross-Platform File System Operations Based on 'libuv'. R package version 1.5.2. https://CRAN.R-project.org/package=fs
## - Kirill Müller and Hadley Wickham (2022). tibble: Simple Data Frames. R package version 3.1.8. https://CRAN.R-project.org/package=tibble
## - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package:Tests in Linear Mixed Effects Models." _Journal of StatisticalSoftware_, *82*(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13).
## - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
## - Lüdecke D (2018). "ggeffects: Tidy Data Frames of Marginal Effects fromRegression Models." _Journal of Open Source Software_, *3*(26), 772.doi: 10.21105/joss.00772 (URL: https://doi.org/10.21105/joss.00772).
## - R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## - Rinker, T. W. & Kurkiewicz, D. (2017). pacman: Package Management for R. version 0.5.0. Buffalo, New York. http://github.com/trinker/pacman
## - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
## - Yihui Xie (2021). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.37.
social relevance
There is a main effect of topic such that health articles are rated as more socially relevant than climate articles.
These data are not consistent with moderation by topic.
model table
summary